home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Development / Source / DBL Pascal Library / Fast-BV / FastBitVector.p < prev   
Text File  |  1993-04-20  |  21KB  |  728 lines
  1. unit FastBitVector;
  2.  
  3. {A bit vector (BV) is a fixed-size vector of bits numbered 0..N, where N = size-1.}
  4. {Bit vector sizes range from 0 to MAXINT. The empty vector (size=0) is supported,}
  5. {but not particularly useful… Bit vectors are allocated in Mac handles, and are never}
  6. {locked by this unit; it doesn't buy you anything to lock a bit-vector, so don't bother.}
  7. {This unit defines operations to manipulate both individual bits and entire bit vectors.}
  8.  
  9. interface
  10.  
  11.     type
  12.         BitVector = Handle;
  13.         BitVectorSize = 0..MAXINT;
  14.  
  15. {Call InitFastBitVector once before making any other call.}
  16.     procedure InitFastBitVector;
  17.  
  18. {NewBV returns nil if it can't allocate a BV of the specified length.}
  19. {The BV contents are not initialized.}
  20.     function NewBV (length: BitVectorSize): BitVector;
  21.  
  22. {Call DisposeBV to release the memory occupied by a BV when you}
  23. {don't need it any more. The BV may not be referenced after DisposeBV.}
  24.     procedure DisposeBV (theBV: BitVector);
  25.  
  26. {To find out the length of your BV, use this. Remember that indices}
  27. {run from 0 to length - 1.}
  28.     function BVLength (theBV: BitVector): BitVectorSize;
  29.  
  30. {The following group of operations changes the new destination size to be the}
  31. {minimum of the source and original destination sizes. It's OK for the destination}
  32. {to be the same as a source. The …Cmpl variants complement the bits of src2}
  33. {before applying the operation.}
  34.     procedure BVCopy (src, dst: BitVector);
  35.     procedure BVBitAND (src1, src2, dst: BitVector);
  36.     procedure BVBitANDCmpl (src1, src2, dst: BitVector);
  37.     procedure BVBitOR (src1, src2, dst: BitVector);
  38.     procedure BVBitORCmpl (src1, src2, dst: BitVector);
  39.     procedure BVBitEOR (src1, src2, dst: BitVector);
  40.     procedure BVBitEORCmpl (src1, src2, dst: BitVector);
  41.     procedure BVBitNOT (src, dst: BitVector);
  42.  
  43. {BVEqual is true iff the BVs are the same length and same contents.}
  44.     function BVEqual (bv1, bv2: BitVector): Boolean;
  45.  
  46. {BVUnequal is true iff the BVs are different lengths or have different contents.}
  47.     function BVUnequal (bv1, bv2: BitVector): Boolean;
  48.  
  49. {These alter the length of a BV. They do nothing if the newLength is not}
  50. {compatible with the operation, i.e. you can't truncate a BV to make it longer}
  51. {or extend a BV to make it shorter. BVExpand leaves the additional bits undetermined.}
  52. {BVAlterLength changes the size either larger or smaller, leaving any new bits undetermined.}
  53.     procedure BVTruncate (bv: BitVector; newLength: BitVectorSize);
  54.     function BVExpand (bv: BitVector; newLength: BitVectorSize): OSErr;
  55.     function BVExtend1 (bv: BitVector; newLength: BitVectorSize): OSErr;
  56.     function BVExtend0 (bv: BitVector; newLength: BitVectorSize): OSErr;
  57.     function BVAlterLength (bv: BitVector; newLength: BitVectorSize): OSErr;
  58.  
  59. {Set or clear all bits at once.}
  60.     procedure BVSetAllBits (theBV: BitVector);
  61.     procedure BVClearAllBits (theBV: BitVector);
  62.  
  63. {Test a BV to see whether its bits are all set or all clear.}
  64.     function BVTestAllClear (theBV: BitVector): Boolean;
  65.     function BVTestAllSet (theBV: BitVector): Boolean;
  66.  
  67. {These set or clear the specified bit if it falls withing the BV.}
  68.     procedure BVSetBit (theBV: BitVector; theBit: Integer);
  69.     procedure BVClearBit (theBV: BitVector; theBit: Integer);
  70.  
  71. {BVTestBit returns the state of the specified bit if it falls within the BV.}
  72.     function BVTestBit (theBV: BitVector; theBit: Integer): Boolean;
  73.  
  74. {BVFindNextSetBit scans the BV for the next set bit beyond the specified index,}
  75. {and updates index to indicate the found bit. When no more bits, index becomes -1.}
  76. {To find all set bits, start with index = -1 and call until index becomes -1 again.}
  77.     procedure BVFindNextSetBit (bv: BitVector; var index: Integer);
  78.  
  79. {BVMoveBits copies a run of bits from the src BV into the dst BV at a specified position.}
  80. {The dst BV is never extended - moved bits are lost if they won't fit into the dst BV.}
  81.     procedure BVMoveBits (src: BitVector; start, length: Integer; dst: BitVector; position: Integer);
  82.  
  83. {BVCatenate extends the first BV with the bits from the second BV.}
  84.     function BVCatenate (bv1, bv2: BitVector): OSErr;
  85.  
  86. {BVLoadBits and BVStoreBits move _only_ the bits (not the size) of a bit-vector to}
  87. {a specified location in memory. You have to be sure the in-memory structure}
  88. {matches the size of the bit vector data. Note that you have to leave space for the}
  89. {entire last byte of the data, even if not all bits are used.}
  90.     procedure BVLoadBits (theBV: BitVector; theBits: Ptr);
  91.     procedure BVStoreBits (theBV: BitVector; theBits: Ptr);
  92.  
  93. {The M variants work on data stored at a fixed location in memory. None of these}
  94. {can modify the size of the bit vector. No range checking is done. For some routines,}
  95. {an extra parameter is added to specify the length of the vector in bits.}
  96.     procedure BVMClearAllBits (theBits: Ptr; length: BitVectorSize);
  97.     function BVMEqual (theBits1, theBits2: Ptr; length: BitVectorSize): Boolean;
  98.     procedure BVMSetBit (theBits: Ptr; theBit: Integer);
  99.     procedure BVMClearBit (theBits: Ptr; theBit: Integer);
  100.     function BVMTestBit (theBits: Ptr; theBit: Integer): Boolean;
  101.  
  102. implementation
  103.  
  104. {NOTE: All inline code is documented in Fast-bv.lap.lisp.}
  105.  
  106. {The general strategy is to perform all operations bytewise (yes, slightly suboptimal in terms of speed,}
  107. {but smaller code) using inline routines, and fix up the boundary bytes with special-case code if needed.}
  108. {We always make sure that any unused bits in the last byte are set to zero.}
  109.  
  110.     type
  111.         LookupTables = packed record
  112.                 masks: packed array[0..7] of SignedByte;
  113.                 offsets: packed array[0..255] of SignedByte;
  114.             end;
  115.         LookupTablesPtr = ^LookupTables;
  116.         LookupTablesHandle = ^LookupTablesPtr;
  117.  
  118.     var
  119.         BVLookups: LookupTablesHandle;
  120.  
  121.     procedure InitFastBitVector;
  122.         var
  123.             i, v: Integer;
  124.     begin
  125.         BVLookups := LookupTablesHandle(NewHandleClear(SIZEOF(LookupTables)));
  126.         with BVLookups^^ do
  127.             begin
  128.                 v := $FF;
  129.                 for i := 0 to 7 do
  130.                     begin
  131.                         masks[i] := v;
  132.                         v := BSR(v, 1);
  133.                     end;
  134.                 offsets[1] := -1;
  135.                 offsets[2] := -2;
  136.                 offsets[4] := -3;
  137.                 offsets[8] := -4;
  138.                 offsets[16] := -5;
  139.                 offsets[32] := -6;
  140.                 offsets[64] := -7;
  141.                 offsets[128] := -8;
  142.                 for i := 1 to 255 do
  143.                     begin
  144.                         if offsets[i] <> 0 then
  145.                             v := offsets[i]
  146.                         else
  147.                             offsets[i] := v;
  148.                     end;
  149.             end;
  150.     end;
  151.  
  152.     type
  153.         BVRec = record
  154.                 len: BitVectorSize;
  155.                 case Integer of
  156.                     0: (
  157.                             vec: packed array[1..1] of Boolean;
  158.                     );
  159.                     1: (
  160.                             bytes: packed array[1..1] of SignedByte;
  161.                     );
  162.             end;
  163.         BVPtr = ^BVRec;
  164.         BVHdl = ^BVPtr;
  165.  
  166.     function NewBV (length: BitVectorSize): BitVector;
  167.         var
  168.             bvH: BVHdl;
  169.     begin
  170.         bvH := BVHdl(NewHandle(SIZEOF(BitVectorSize) + (length + 7) div 8));
  171.         bvH^^.len := length;
  172.         NewBV := BitVector(bvH);
  173.     end;
  174.  
  175.     procedure DisposeBV (theBV: BitVector);
  176.     begin
  177.         DisposHandle(Handle(theBV));
  178.     end;
  179.  
  180.     function BVLength (theBV: BitVector): BitVectorSize;
  181.     begin
  182.         BVLength := BVHdl(theBV)^^.len;
  183.     end;
  184.  
  185.     function VecBytes (bv: BVHdl): Integer;
  186.     begin
  187.         VecBytes := (bv^^.len + 7) div 8
  188.     end;
  189.  
  190.     procedure ClearEndFill (bv: BVHdl);
  191.         var
  192.             lastByte, residue: Integer;
  193.     begin
  194.         lastByte := VecBytes(bv);
  195.         residue := bv^^.len mod 8;
  196.         if residue > 0 then
  197.             with bv^^ do
  198.                 bytes[lastByte] := BAND(bytes[lastByte], BNOT(BVLookups^^.masks[residue]));
  199.     end;
  200.  
  201.     procedure ConformLength (src1, src2, dst: BVHdl);
  202.         var
  203.             minLen: BitVectorSize;
  204.     begin
  205.         minLen := src1^^.len;
  206.         with src2^^ do
  207.             if len < minLen then
  208.                 minLen := len;
  209.         with dst^^ do
  210.             begin
  211.                 if len < minLen then
  212.                     minLen := len;
  213.                 if minLen < len then
  214.                     begin
  215.                         len := minLen;
  216.                         SetHandleSize(Handle(dst), SIZEOF(BitVectorSize) + VecBytes(dst));
  217.                         ClearEndFill(dst);
  218.                     end;
  219.             end;
  220.     end;
  221.  
  222.     procedure BVCopy (src, dst: BitVector);
  223.         var
  224.             bvSH, bvDH: BVHdl;
  225.     begin
  226.         bvSH := BVHdl(src);
  227.         bvDH := BVHdl(dst);
  228.         ConformLength(bvSH, bvSH, bvDH);
  229.         BlockMove(@bvSH^^.vec, @bvDH^^.vec, VecBytes(bvDH));
  230.     end;
  231.  
  232.     procedure BlockFill_Inline (value: SignedByte; block: Ptr; length: Integer);
  233.     inline
  234.         $321F, $5341, $205F, $301F, $10C0, $51C9, $FFFC;
  235.  
  236.     procedure BVSetAllBits (theBV: BitVector);
  237.         var
  238.             bvH: BVHdl;
  239.     begin
  240.         bvH := BVHdl(theBV);
  241.         BlockFill_Inline($FF, @bvH^^.vec, VecBytes(bvH));
  242.         ClearEndFill(bvH);
  243.     end;
  244.  
  245.     function BitIndexOK (theBV: BitVector; theBit: Integer): Boolean;
  246.     begin
  247.         BitIndexOK := (theBit >= 0) and (theBit < BVHdl(theBV)^^.len);
  248.     end;
  249.  
  250.     procedure BVSetBit (theBV: BitVector; theBit: Integer);
  251.         var
  252.             bvH: BVHdl;
  253.     begin
  254.         bvH := BVHdl(theBV);
  255.         if BitIndexOK(theBV, theBit) then
  256.             BitSet(@bvH^^.vec, theBit);
  257.     end;
  258.  
  259.     procedure BVClearAllBits (theBV: BitVector);
  260.         var
  261.             bvH: BVHdl;
  262.     begin
  263.         bvH := BVHdl(theBV);
  264.         BlockFill_Inline($00, @bvH^^.vec, VecBytes(bvH));
  265.     end;
  266.  
  267.     procedure BVClearBit (theBV: BitVector; theBit: Integer);
  268.         var
  269.             bvH: BVHdl;
  270.     begin
  271.         bvH := BVHdl(theBV);
  272.         if BitIndexOK(theBV, theBit) then
  273.             BitClr(@bvH^^.vec, theBit);
  274.     end;
  275.  
  276.     function BVTestBit (theBV: BitVector; theBit: Integer): Boolean;
  277.         var
  278.             bvH: BVHdl;
  279.     begin
  280.         bvH := BVHdl(theBV);
  281.         BVTestBit := BitTst(@bvH^^.vec, theBit);
  282.     end;
  283.  
  284.     function BlockAllClear_Inline (bv: Ptr; length: Integer): Boolean;
  285.     inline
  286.         $321F, $5341, $205F, $4A18, $56C9, $FFFC, $57EF, $0001, {}
  287.         $442F, $0001;
  288.  
  289.     function BVTestAllClear (theBV: BitVector): Boolean;
  290.         var
  291.             bvH: BVHdl;
  292.             len, byteCount: Integer;
  293.             allZero: Boolean;
  294.     begin
  295.         bvH := BVHdl(theBV);
  296.         len := bvH^^.len;
  297.         byteCount := VecBytes(bvH);
  298. {$PUSH}
  299. {$R-}
  300.         allZero := BAND(bvH^^.bytes[byteCount], BNOT(BVLookups^^.masks[len mod 8])) = 0;
  301. {$POP}
  302.         if allZero & (byteCount > 1) then
  303.             allZero := BlockAllClear_Inline(@bvH^^.vec, byteCount - 1);
  304.         BVTestAllClear := allZero;
  305.     end;
  306.  
  307.     function BlockAllSet_Inline (bv: Ptr; length: Integer): Boolean;
  308.     inline
  309.         $321F, $5341, $205F, $4A18, $57C9, $FFFC, $56EF, $0001, {}
  310.         $442F, $0001;
  311.  
  312.     function BVTestAllSet (theBV: BitVector): Boolean;
  313.         var
  314.             bvH: BVHdl;
  315.             len, byteCount: Integer;
  316.             allOnes: Boolean;
  317.     begin
  318.         bvH := BVHdl(theBV);
  319.         len := bvH^^.len;
  320.         byteCount := VecBytes(bvH);
  321. {$PUSH}
  322. {$R-}
  323.         allOnes := BOR(bvH^^.bytes[byteCount], BVLookups^^.masks[len mod 8]) = $FF;
  324. {$POP}
  325.         if allOnes & (byteCount > 1) then
  326.             allOnes := BlockAllSet_Inline(@bvH^^.vec, byteCount - 1);
  327.         BVTestAllSet := allOnes;
  328.     end;
  329.  
  330.     function BlockEqual_Inline (bv1, bv2: Ptr; length: Integer): Boolean;
  331.     inline
  332.         $321F, $5341, $225F, $205F, $B308, $56C9, $FFFC, $57EF, {}
  333.         $0001, $442F, $0001;
  334.  
  335.     function BVEqual (bv1, bv2: BitVector): Boolean;
  336.         var
  337.             bv1H, bv2H: BVHdl;
  338.             len: Integer;
  339.     begin
  340.         bv1H := BVHdl(bv1);
  341.         bv2H := bvHdl(bv2);
  342.         len := bv1H^^.len;
  343.         if len <> bv2H^^.len then
  344.             BVEqual := False
  345.         else
  346.             BVEqual := BlockEqual_Inline(@bv1H^^.vec, @bv2H^^.vec, VecBytes(bv1H));
  347.     end;
  348.  
  349.     function BlockUnequal_Inline (bv1, bv2: Ptr; length: Integer): Boolean;
  350.     inline
  351.         $321F, $5341, $225F, $205F, $B308, $57C9, $FFFC, $56EF, {}
  352.         $0001, $442F, $0001;
  353.  
  354.     function BVUnequal (bv1, bv2: BitVector): Boolean;
  355.         var
  356.             bv1H, bv2H: BVHdl;
  357.             len: Integer;
  358.     begin
  359.         bv1H := BVHdl(bv1);
  360.         bv2H := bvHdl(bv2);
  361.         len := bv1H^^.len;
  362.         if len <> bv2H^^.len then
  363.             BVUnequal := True
  364.         else
  365.             BVUnequal := BlockUnequal_Inline(@bv1H^^.vec, @bv2H^^.vec, VecBytes(bv1H));
  366.     end;
  367.  
  368.     procedure BlockAND_Inline (src1, src2, dst: Ptr; length: Integer);
  369.     inline
  370.         $2F0A, $321F, $5341, $245F, $225F, $205F, $1018, $C019, {}
  371.         $14C0, $51C9, $FFF8, $245F;
  372.  
  373.     procedure BVBitAND (src1, src2, dst: BitVector);
  374.         var
  375.             bv1H, bv2H, bvDH: BVHdl;
  376.     begin
  377.         bv1H := BVHdl(src1);
  378.         bv2H := BVHdl(src2);
  379.         bvDH := BVHdl(dst);
  380.         ConformLength(bv1H, bv2H, bvDH);
  381.         BlockAND_Inline(@bv1H^^.vec, @bv2H^^.vec, @bvDH^^.vec, VecBytes(bvDH));
  382.     end;
  383.  
  384.     procedure BlockANDCmpl_Inline (src1, src2, dst: Ptr; length: Integer);
  385.     inline
  386.         $2F0A, $321F, $5341, $245F, $225F, $205F, $1019, $4600, {}
  387.         $C018, $14C0, $51C9, $FFF6, $245F;
  388.  
  389.     procedure BVBitANDCmpl (src1, src2, dst: BitVector);
  390.         var
  391.             bv1H, bv2H, bvDH: BVHdl;
  392.     begin
  393.         bv1H := BVHdl(src1);
  394.         bv2H := BVHdl(src2);
  395.         bvDH := BVHdl(dst);
  396.         ConformLength(bv1H, bv2H, bvDH);
  397.         BlockANDCmpl_Inline(@bv1H^^.vec, @bv2H^^.vec, @bvDH^^.vec, VecBytes(bvDH));
  398.     end;
  399.  
  400.     procedure BlockOR_Inline (src1, src2, dst: Ptr; length: Integer);
  401.     inline
  402.         $2F0A, $321F, $5341, $245F, $225F, $205F, $1018, $8019, {}
  403.         $14C0, $51C9, $FFF8, $245F;
  404.  
  405.     procedure BVBitOR (src1, src2, dst: BitVector);
  406.         var
  407.             bv1H, bv2H, bvDH: BVHdl;
  408.     begin
  409.         bv1H := BVHdl(src1);
  410.         bv2H := BVHdl(src2);
  411.         bvDH := BVHdl(dst);
  412.         ConformLength(bv1H, bv2H, bvDH);
  413.         BlockOR_Inline(@bv1H^^.vec, @bv2H^^.vec, @bvDH^^.vec, VecBytes(bvDH));
  414.     end;
  415.  
  416.     procedure BlockORCmpl_Inline (src1, src2, dst: Ptr; length: Integer);
  417.     inline
  418.         $2F0A, $321F, $5341, $245F, $225F, $205F, $1019, $4600, {}
  419.         $8018, $14C0, $51C9, $FFF6, $245F;
  420.  
  421.     procedure BVBitORCmpl (src1, src2, dst: BitVector);
  422.         var
  423.             bv1H, bv2H, bvDH: BVHdl;
  424.     begin
  425.         bv1H := BVHdl(src1);
  426.         bv2H := BVHdl(src2);
  427.         bvDH := BVHdl(dst);
  428.         ConformLength(bv1H, bv2H, bvDH);
  429.         BlockORCmpl_Inline(@bv1H^^.vec, @bv2H^^.vec, @bvDH^^.vec, VecBytes(bvDH));
  430.         ClearEndFill(bvDH);
  431.     end;
  432.  
  433.     procedure BlockEOR_Inline (src1, src2, dst: Ptr; length: Integer);
  434.     inline
  435.         $2F0A, $321F, $5341, $245F, $225F, $205F, $1018, $1219, {}
  436.         $B300, $14C0, $51C9, $FFF6, $245F;
  437.  
  438.     procedure BVBitEOR (src1, src2, dst: BitVector);
  439.         var
  440.             bv1H, bv2H, bvDH: BVHdl;
  441.     begin
  442.         bv1H := BVHdl(src1);
  443.         bv2H := BVHdl(src2);
  444.         bvDH := BVHdl(dst);
  445.         ConformLength(bv1H, bv2H, bvDH);
  446.         BlockEOR_Inline(@bv1H^^.vec, @bv2H^^.vec, @bvDH^^.vec, VecBytes(bvDH));
  447.     end;
  448.  
  449.     procedure BlockEORCmpl_Inline (src1, src2, dst: Ptr; length: Integer);
  450.     inline
  451.         $2F0A, $321F, $5341, $245F, $225F, $205F, $1219, $4601, {}
  452.         $1018, $B300, $14C0, $51C9, $FFF4, $245F;
  453.  
  454.     procedure BVBitEORCmpl (src1, src2, dst: BitVector);
  455.         var
  456.             bv1H, bv2H, bvDH: BVHdl;
  457.     begin
  458.         bv1H := BVHdl(src1);
  459.         bv2H := BVHdl(src2);
  460.         bvDH := BVHdl(dst);
  461.         ConformLength(bv1H, bv2H, bvDH);
  462.         BlockEORCmpl_Inline(@bv1H^^.vec, @bv2H^^.vec, @bvDH^^.vec, VecBytes(bvDH));
  463.         ClearEndFill(bvDH);
  464.     end;
  465.  
  466.     procedure BlockNOT_Inline (src, dst: Ptr; length: Integer);
  467.     inline
  468.         $321F, $5341, $225F, $205F, $1018, $4600, $12C0, $51C9, {}
  469.         $FFF8;
  470.  
  471.     procedure BVBitNOT (src, dst: BitVector);
  472.         var
  473.             bvSH, bvDH: BVHdl;
  474.     begin
  475.         bvSH := BVHdl(src);
  476.         bvDH := BVHdl(dst);
  477.         ConformLength(bvSH, bvSH, bvDH);
  478.         BlockNOT_Inline(@bvSH^^.vec, @bvDH^^.vec, VecBytes(bvDH));
  479.         ClearEndFill(bvDH);
  480.     end;
  481.  
  482.     procedure BVTruncate (bv: BitVector; newLength: BitVectorSize);
  483.         var
  484.             bvH: BVHdl;
  485.     begin
  486.         bvH := BVHdl(bv);
  487.         with bvH^^ do
  488.             if newLength < len then
  489.                 begin
  490.                     len := newLength;
  491.                     SetHandleSize(Handle(bvH), SIZEOF(BitVectorSize) + VecBytes(bvH));
  492.                     ClearEndFill(bvH);
  493.                 end;
  494.     end;
  495.  
  496.     function BVExpand (bv: BitVector; newLength: BitVectorSize): OSErr;
  497.         var
  498.             bvH: BVHdl;
  499.             err: OSErr;
  500.     begin
  501.         bvH := BVHdl(bv);
  502.         if newLength > bvH^^.len then
  503.             bvH^^.len := newLength;
  504.         SetHandleSize(Handle(bvH), SIZEOF(BitVectorSize) + VecBytes(bvH));
  505.         err := MemError;
  506.         BVExpand := err;
  507.         if err = noErr then
  508.             ClearEndFill(bvH);
  509.     end;
  510.  
  511.     function BVAlterLength (bv: BitVector; newLength: BitVectorSize): OSErr;
  512.         var
  513.             bvH: BVHdl;
  514.             err: OSErr;
  515.     begin
  516.         bvH := BVHdl(bv);
  517.         SetHandleSize(Handle(bvH), SIZEOF(BitVectorSize) + VecBytes(bvH));
  518.         err := MemError;
  519.         BVAlterLength := err;
  520.     end;
  521.  
  522.     function BVExtend1 (bv: BitVector; newLength: BitVectorSize): OSErr;
  523.         var
  524.             bvH: BVHdl;
  525.             oldLen: BitVectorSize;
  526.             oldByteCount, oldResidue, extraByteCount: Integer;
  527.             err: OSErr;
  528.     begin
  529.         bvH := BVHdl(bv);
  530.         oldLen := bvH^^.len;
  531.         oldByteCount := VecBytes(bvH);
  532.         err := BVExpand(bv, newLength);
  533.         BVExtend1 := err;
  534.         if err = noErr then
  535.             begin
  536.                 oldResidue := oldLen mod 8;
  537.                 if oldResidue > 0 then
  538.                     with bvH^^ do
  539. {$PUSH}
  540. {$R-}
  541.                         bytes[oldByteCount] := BOR(bytes[oldByteCount], BVLookups^^.masks[oldResidue]);
  542. {$POP}
  543.                 extraByteCount := VecBytes(bvH) - oldByteCount;
  544.                 if extraByteCount > 0 then
  545.                     begin
  546. {$PUSH}
  547. {$R-}
  548.                         BlockFill_Inline($FF, @bvH^^.bytes[oldByteCount + 1], extraByteCount);
  549. {$POP}
  550.                         ClearEndFill(bvH);
  551.                     end;
  552.             end;
  553.     end;
  554.  
  555.     function BVExtend0 (bv: BitVector; newLength: BitVectorSize): OSErr;
  556.         var
  557.             bvH: BVHdl;
  558.             oldLen: BitVectorSize;
  559.             oldByteCount, oldResidue, extraByteCount: Integer;
  560.             err: OSErr;
  561.     begin
  562.         bvH := BVHdl(bv);
  563.         oldLen := bvH^^.len;
  564.         oldByteCount := VecBytes(bvH);
  565.         err := BVExpand(bv, newLength);
  566.         BVExtend0 := err;
  567.         if err = noErr then
  568.             begin
  569.                 oldResidue := oldLen mod 8;
  570.                 if oldResidue > 0 then
  571.                     with bvH^^ do
  572. {$PUSH}
  573. {$R-}
  574.                         bytes[oldByteCount] := BAND(bytes[oldByteCount], BNOT(BVLookups^^.masks[oldResidue]));
  575. {$POP}
  576.                 extraByteCount := VecBytes(bvH) - oldByteCount;
  577.                 if extraByteCount > 0 then
  578. {$PUSH}
  579. {$R-}
  580.                     BlockFill_Inline($00, @bvH^^.bytes[oldByteCount + 1], extraByteCount);
  581. {$POP}
  582.             end;
  583.     end;
  584.  
  585.     procedure NextBit_Inline (table: Ptr; bvPtr: Ptr; var index: Integer);
  586.     inline    {Optimized for relatively sparse bit-vectors}
  587.         $48E7, $1020, $225F, $3011, $205F, $245F, $2F09, $3418, {}
  588.         $2248, $5240, $B042, $6C36, $3600, $E648, $48C0, $D1C0, {}
  589.         $5E42, $E64A, $9440, $5342, $4241, $1218, $C67C, $0007, {}
  590.         $C232, $30F8, $6002, $1218, $56CA, $FFFC, $6710, $1232, {}
  591.         $1000, $4881, $91C9, $3008, $E748, $D240, $6004, $323C, {}
  592.         $FFFF, $225F, $3281, $4CDF, $0408;
  593.  
  594.     procedure BVFindNextSetBit (bv: BitVector; var index: Integer);
  595.     begin
  596.         NextBit_Inline(@BVLookups^^.offsets, Ptr(bv^), index);
  597.     end;
  598.  
  599.     procedure BlockShiftBitsLeft_Inline (src, dst: Ptr; shift, length: Integer);
  600.     inline {Shift source data left by 1..7 bits while copying to destination.}
  601.         $48E7, $1800, $381F, $5344, $341F, $3602, $4443, $5043, {}
  602.         $225F, $205F, $4240, $1018, $E528, $1210, $E629, $8001, {}
  603.         $12C0, $51CC, $FFF0, $4CDF, $0018;
  604.  
  605.     procedure BVMoveBits (src: BitVector; start, length: Integer; dst: BitVector; position: Integer);
  606.         var
  607.             bvS, bvD: BVHdl;
  608.             startResidue, positionResidue: Integer;
  609.             srcLength, dstLength: Integer;
  610.             srcBytesBegin, dstBytesBegin, bytesToCopy, shiftCount, mask, lastDstByte: Integer;
  611.             aByte: SignedByte;
  612.     begin
  613. {• This is unfinished - The general form is OK, but lots of “fenceposts” need adjusting…}
  614.         bvS := BVHdl(src);
  615.         bvD := BVHdl(dst);
  616.         srcLength := bvS^^.len;
  617.         dstLength := bvD^^.len;
  618.         if (start < srcLength) and (position < dstLength) then
  619.             begin
  620.                 if start + length > srcLength then
  621.                     length := srcLength - start;
  622.                 if position + length > dstLength then
  623.                     length := dstLength - position;
  624.                 bytesToCopy := length div 8;
  625.                 srcBytesBegin := start div 8;
  626.                 startResidue := start mod 8;
  627.                 if startResidue > 0 then
  628.                     begin
  629.                         srcBytesBegin := srcBytesBegin + 1;
  630.                         bytesToCopy := bytesToCopy - 1;
  631.                     end;
  632.                 dstBytesBegin := position div 8;
  633.                 lastDstByte := dstBytesBegin + bytesToCopy;
  634.                 positionResidue := position mod 8;
  635.                 if positionResidue > 0 then
  636.                     dstBytesBegin := dstBytesBegin + 1;
  637.                 if startResidue = positionResidue then
  638.                     begin
  639.                         mask := BVLookups^^.masks[positionResidue];
  640. {$PUSH}
  641. {$R-}
  642.                         bvD^^.bytes[dstBytesBegin] := BOR(BAND(bvS^^.bytes[srcBytesBegin], mask), BAND(bvD^^.bytes[srcBytesBegin], BNOT(mask)));
  643.                         BlockMove(@bvS^^.bytes[srcBytesBegin], @bvD^^.bytes[dstBytesBegin], bytesToCopy);
  644. {$POP}
  645.                         mask := BVLookups^^.masks[(position + length) mod 8];
  646. {$PUSH}
  647. {$R-}
  648.                         bvD^^.bytes[lastDstByte] := BOR(BAND(bvS^^.bytes[srcBytesBegin + bytesToCopy], mask), BAND(bvD^^.bytes[lastDstByte], BNOT(mask)));
  649. {$POP}
  650.                     end
  651.                 else
  652.                     begin
  653.                         shiftCount := positionResidue - startResidue;
  654.                         if shiftCount < 0 then
  655.                             begin
  656.                                 shiftCount := shiftCount + 8;
  657.                             end;
  658. {$PUSH}
  659. {$R-}
  660.                         BlockShiftBitsLeft_Inline(@bvS^^.bytes[srcBytesBegin], @aByte, shiftCount, 1);
  661. {$POP}
  662.                         mask := BVLookups^^.masks[shiftCount];
  663.                         bvD^^.bytes[dstBytesBegin] := BOR(BAND(aByte, mask), BAND(bvD^^.bytes[srcBytesBegin], BNOT(mask)));
  664. {$PUSH}
  665. {$R-}
  666.                         BlockShiftBitsLeft_Inline(@bvS^^.bytes[srcBytesBegin], @bvD^^.bytes[dstBytesBegin], shiftCount, bytesToCopy);
  667. {$POP}
  668.                         mask := BVLookups^^.masks[(position + length) mod 8];
  669. {$PUSH}
  670. {$R-}
  671.                         BlockShiftBitsLeft_Inline(@bvS^^.bytes[srcBytesBegin + bytesToCopy], @aByte, shiftCount, 1);
  672.                         bvD^^.bytes[lastDstByte] := BOR(BAND(aByte, mask), BAND(bvD^^.bytes[lastDstByte], BNOT(mask)));
  673. {$POP}
  674.                     end;
  675.             end;
  676.     end;
  677.  
  678.     function BVCatenate (bv1, bv2: BitVector): OSErr;
  679.         var
  680.             bv1Length, bv2Length: Integer;
  681.             err: OSErr;
  682.     begin
  683.         bv1Length := BVLength(bv1);
  684.         bv2Length := BVLength(bv2);
  685.         err := BVExpand(bv1, bv1Length + bv2Length);
  686.         BVCatenate := err;
  687.         if err = noErr then
  688.             BVMoveBits(bv2, 0, bv2Length, bv1, bv1Length);
  689.     end;
  690.  
  691.     procedure BVLoadBits (theBV: BitVector; theBits: Ptr);
  692.     begin
  693.         with BVHdl(theBV)^^ do
  694.             BlockMove(theBits, @bytes, VecBytes(BVHdl(theBV)));
  695.     end;
  696.  
  697.     procedure BVStoreBits (theBV: BitVector; theBits: Ptr);
  698.     begin
  699.         with BVHdl(theBV)^^ do
  700.             BlockMove(@bytes, theBits, VecBytes(BVHdl(theBV)));
  701.     end;
  702.  
  703.     procedure BVMClearAllBits (theBits: Ptr; length: BitVectorSize);
  704.     begin
  705.         BlockFill_Inline($00, theBits, (length + 7) div 8);
  706.     end;
  707.  
  708.     function BVMEqual (theBits1, theBits2: Ptr; length: BitVectorSize): Boolean;
  709.     begin
  710.         BVMEqual := BlockEqual_Inline(theBits1, theBits2, (length + 7) div 8);
  711.     end;
  712.  
  713.     procedure BVMSetBit (theBits: Ptr; theBit: Integer);
  714.     begin
  715.         BitSet(theBits, theBit);
  716.     end;
  717.  
  718.     procedure BVMClearBit (theBits: Ptr; theBit: Integer);
  719.     begin
  720.         BitClr(theBits, theBit);
  721.     end;
  722.  
  723.     function BVMTestBit (theBits: Ptr; theBit: Integer): Boolean;
  724.     begin
  725.         BVMTestBit := BitTst(theBits, theBit);
  726.     end;
  727.  
  728. end.